home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / scheme / compiler.t next >
Text File  |  1990-04-12  |  3KB  |  60 lines
  1. (herald compiler)
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, K Pitman, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warranty or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26. ;;; Modified by Ashwin Ram, July 1985
  27.  
  28. (*define scheme-env 'compile-file
  29.  (lambda (spec)
  30.    ((*value orbit-env 'totally-comfile)
  31.     spec
  32.     spec
  33.     standard-read-table
  34.     scheme-syntax-table
  35.     scheme-early-binding-env)))
  36.  
  37. (define (create-scheme-support . files)
  38.   (let ((env ((*value orbit-env 'make-early-binding-locale)
  39.           (*value orbit-env 'standard-early-binding-env)
  40.               'scheme-early-binding-env)))
  41. ;    (walk (lambda (n)
  42. ;            (cond ((standard-early-binding-env n)
  43. ;                   => (lambda (d)
  44. ;                        (set (env n) d)))))
  45. ;          scheme-from-t)
  46.     (walk (lambda (p)
  47.             (cond ((standard-early-binding-env (cadr p))
  48.                    => (lambda (d)
  49.                         (set (env (car p)) d)))))
  50.           scheme-aliased-from-t)
  51.     (walk (lambda (f)
  52.             ((*value orbit-env 'load-early-bindings) f env))
  53.           files)
  54.     env))
  55.     
  56. (define scheme-early-binding-env
  57.   (create-scheme-support
  58.    (list 'tscheme 'runtime (*value orbit-env '*information-file-extension*))))
  59.  
  60.